home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH13 / SRC / OBJSPHR.CLS < prev    next >
Encoding:
Text File  |  1996-04-11  |  8.4 KB  |  323 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjSphere"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. Private Radius As Single
  11. Private Center As Point3D
  12.  
  13. Private HitX As Single
  14. Private HitY As Single
  15. Private HitZ As Single
  16.  
  17. Private Kar As Single
  18. Private Kag As Single
  19. Private Kab As Single
  20.  
  21. Private Kdr As Single
  22. Private Kdg As Single
  23. Private Kdb As Single
  24.  
  25. Private SpecN As Single
  26. Private Ks As Single
  27.  
  28. Private Krr As Single
  29. Private Krg As Single
  30. Private Krb As Single
  31.  
  32. ' ************************************************
  33. ' Apply a transformation matrix to the sphere.
  34. ' ************************************************
  35. Public Sub Apply(M() As Single)
  36.     ' Transform the center.
  37.     m3Apply Center.coord, M, Center.trans
  38. End Sub
  39. ' ************************************************
  40. ' Return the red, green, and blue components of
  41. ' the surface at the hit position.
  42. ' ************************************************
  43. Public Sub HitColor(depth As Integer, Objects As Collection, R As Integer, G As Integer, B As Integer)
  44. Dim nx As Single
  45. Dim ny As Single
  46. Dim nz As Single
  47. Dim lx As Single
  48. Dim ly As Single
  49. Dim lz As Single
  50. Dim Vx As Single
  51. Dim Vy As Single
  52. Dim Vz As Single
  53. Dim rx As Single
  54. Dim ry As Single
  55. Dim rz As Single
  56. Dim n_len As Single
  57. Dim l_len As Single
  58. Dim v_len As Single
  59. Dim r_len As Single
  60. Dim NdotL As Single
  61. Dim RdotV As Single
  62. Dim NdotV As Single
  63. Dim r_dif As Single
  64. Dim g_dif As Single
  65. Dim b_dif As Single
  66. Dim r_amb As Single
  67. Dim g_amb As Single
  68. Dim b_amb As Single
  69. Dim spec As Single
  70. Dim r_ref As Single
  71. Dim g_ref As Single
  72. Dim b_ref As Single
  73. Dim r1 As Integer
  74. Dim g1 As Integer
  75. Dim b1 As Integer
  76. Dim mx As Single
  77. Dim my As Single
  78. Dim mz As Single
  79. Dim i As Integer
  80. Dim dist As Single
  81. Dim shadowed As Boolean
  82. Dim rlng As Long
  83. Dim glng As Long
  84. Dim blng As Long
  85.  
  86.     ' *******************************
  87.     ' * Compute local contributions *
  88.     ' *******************************
  89.     
  90.     ' Find the unit vector pointing toward the light.
  91.     lx = LightSource.trans(1) - HitX
  92.     ly = LightSource.trans(2) - HitY
  93.     lz = LightSource.trans(3) - HitZ
  94.     l_len = Sqr(lx * lx + ly * ly + lz * lz)
  95.     lx = lx / l_len
  96.     ly = ly / l_len
  97.     lz = lz / l_len
  98.     ' We will use l_len later as the distance from
  99.     ' the light to the surface.
  100.  
  101.     ' Find the surface unit normal.
  102.     nx = HitX - Center.trans(1)
  103.     ny = HitY - Center.trans(2)
  104.     nz = HitZ - Center.trans(3)
  105.     n_len = Sqr(nx * nx + ny * ny + nz * nz)
  106.     nx = nx / n_len
  107.     ny = ny / n_len
  108.     nz = nz / n_len
  109.     
  110.     ' See if the light shines directly on the surface.
  111.     For i = 1 To Objects.Count
  112.         dist = Objects.Item(i).RayDistance( _
  113.             LightSource.trans(1), _
  114.             LightSource.trans(2), _
  115.             LightSource.trans(3), _
  116.             -lx, -ly, -lz)
  117.         If dist < l_len - 0.1 Then Exit For
  118.     Next i
  119.     shadowed = (i <= Objects.Count)
  120.  
  121.     ' Find vector R in the mirror direction.
  122.     NdotL = nx * lx + ny * ly + nz * lz
  123.     rx = 2 * nx * NdotL - lx
  124.     ry = 2 * ny * NdotL - ly
  125.     rz = 2 * nz * NdotL - lz
  126.     
  127.     ' Find the vector V from the surface to the
  128.     ' viewpoint.
  129.     Vx = EyeX - HitX
  130.     Vy = EyeY - HitY
  131.     Vz = EyeZ - HitZ
  132.     v_len = Sqr(Vx * Vx + Vy * Vy + Vz * Vz)
  133.     Vx = Vx / v_len
  134.     Vy = Vy / v_len
  135.     Vz = Vz / v_len
  136.  
  137.     ' Calculate the part due to diffuse reflection.
  138.     If shadowed Then NdotL = -1
  139.     If NdotL < 0 Then
  140.         ' The light does not hit the surface.
  141.         r_dif = 0
  142.         g_dif = 0
  143.         b_dif = 0
  144.         spec = 0
  145.     Else
  146.         r_dif = Kdr * NdotL
  147.         g_dif = Kdg * NdotL
  148.         b_dif = Kdb * NdotL
  149.         
  150.         ' Calculate the part due to specular reflection.
  151.         RdotV = rx * Vx + ry * Vy + rz * Vz
  152.         If RdotV < 0 Then
  153.             spec = 0
  154.         Else
  155.             spec = Ks * RdotV ^ SpecN
  156.         End If
  157.     End If
  158.     
  159.     ' Calculate the part due to ambient light.
  160.     r_amb = LightIar * Kar
  161.     g_amb = LightIag * Kag
  162.     b_amb = LightIab * Kab
  163.     
  164.     ' **********************************
  165.     ' * Compute reflected contribution *
  166.     ' **********************************
  167.     ' Find vector M in the direction of reflection.
  168.     NdotV = nx * Vx + ny * Vy + nz * Vz
  169.     mx = 2 * nx * NdotV - Vx
  170.     my = 2 * ny * NdotV - Vy
  171.     mz = 2 * nz * NdotV - Vz
  172.     
  173.     If depth > 1 Then
  174.         TraceRay depth - 1, HitX, HitY, HitZ, mx, my, mz, r1, g1, b1
  175.         r_ref = Krr * r1
  176.         g_ref = Krg * g1
  177.         b_ref = Krb * b1
  178.     Else
  179.         r_ref = 0
  180.         g_ref = 0
  181.         b_ref = 0
  182.     End If
  183.     
  184.     ' See how intense to make the color.
  185.     ' Some of the reflections may be close to
  186.     ' the light source so these values can get big.
  187.     rlng = r_amb + _
  188.         LightIir / (l_len + LightKdist) * _
  189.             (r_dif + spec) + _
  190.         r_ref
  191.     glng = g_amb + _
  192.         LightIig / (l_len + LightKdist) * _
  193.             (g_dif + spec) + _
  194.         g_ref
  195.     blng = b_amb + _
  196.         LightIib / (l_len + LightKdist) * _
  197.             (b_dif + spec) + _
  198.         b_ref
  199.     If rlng > 255 Then rlng = 255
  200.     If glng > 255 Then glng = 255
  201.     If blng > 255 Then blng = 255
  202.     R = rlng
  203.     G = glng
  204.     B = blng
  205. End Sub
  206.  
  207. ' ************************************************
  208. ' Compute the distance from point (px, py, pz)
  209. ' along vector <vx, vy, vz> to the sphere.
  210. '
  211. ' Save the point of intersection in
  212. ' (HitX, HitY, HitZ) for later use.
  213. ' ************************************************
  214. Public Function RayDistance(px As Single, py As Single, pz As Single, Vx As Single, Vy As Single, Vz As Single) As Single
  215. Dim A As Single
  216. Dim B As Single
  217. Dim C As Single
  218. Dim Cx As Single
  219. Dim Cy As Single
  220. Dim Cz As Single
  221. Dim B24AC As Single
  222. Dim t1 As Single
  223. Dim t2 As Single
  224.  
  225.     Cx = Center.trans(1)
  226.     Cy = Center.trans(2)
  227.     Cz = Center.trans(3)
  228.  
  229.     ' Get the coefficients for the quadratic.
  230.     A = Vx * Vx + Vy * Vy + Vz * Vz
  231.     B = 2 * Vx * (px - Cx) + _
  232.         2 * Vy * (py - Cy) + _
  233.         2 * Vz * (pz - Cz)
  234.     C = Cx * Cx + Cy * Cy + Cz * Cz + _
  235.         px * px + py * py + pz * pz - _
  236.         2 * (Cx * px + Cy * py + Cz * pz) - _
  237.         Radius * Radius
  238.  
  239.     ' Solve the quadratic A*t^2 + B*t + C = 0.
  240.     B24AC = B * B - 4 * A * C
  241.     If B24AC < 0 Then
  242.         RayDistance = INFINITY
  243.         Exit Function
  244.     ElseIf B24AC = 0 Then
  245.         t1 = -B / 2 / A
  246.     Else
  247.         B24AC = Sqr(B24AC)
  248.         t1 = (-B + B24AC) / 2 / A
  249.         t2 = (-B - B24AC) / 2 / A
  250.         ' Use only positive t values.
  251.         If t1 < 0.01 Then t1 = t2
  252.         If t2 < 0.01 Then t2 = t1
  253.         ' Use the smaller t value.
  254.         If t1 > t2 Then t1 = t2
  255.     End If
  256.  
  257.     ' If there is no positive t value, there's no
  258.     ' intersection in this direction.
  259.     If t1 < 0.01 Then
  260.         RayDistance = INFINITY
  261.         Exit Function
  262.     End If
  263.     
  264.     ' Compute the actual hit location.
  265.     HitX = px + t1 * Vx
  266.     HitY = py + t1 * Vy
  267.     HitZ = pz + t1 * Vz
  268.     
  269.     ' Compute the distance from (px, py, pz).
  270.     A = px - HitX
  271.     B = py - HitY
  272.     C = pz - HitZ
  273.     RayDistance = Sqr(A * A + B * B + C * C)
  274. End Function
  275.  
  276. ' ************************************************
  277. ' Set the center.
  278. ' ************************************************
  279. Public Sub Initialize(R As Single, x As Single, y As Single, z As Single)
  280.     Radius = R
  281.     Center.coord(1) = x
  282.     Center.coord(2) = y
  283.     Center.coord(3) = z
  284.     Center.coord(4) = 1
  285. End Sub
  286.  
  287.  
  288. ' ************************************************
  289. ' Set N and Ks for specular reflection.
  290. ' ************************************************
  291. Sub SetSpec(n As Single, s As Single)
  292.     SpecN = n
  293.     Ks = s
  294. End Sub
  295.  
  296. ' ************************************************
  297. ' Set constants for diffuse reflection.
  298. ' ************************************************
  299. Sub SetKd(R As Single, G As Single, B As Single)
  300.     Kdr = R
  301.     Kdg = G
  302.     Kdb = B
  303. End Sub
  304.  
  305. ' ************************************************
  306. ' Set constants for reflected light.
  307. ' ************************************************
  308. Sub SetKr(R As Single, G As Single, B As Single)
  309.     Krr = R
  310.     Krg = G
  311.     Krb = B
  312. End Sub
  313.  
  314. ' ************************************************
  315. ' Set constants for ambient light.
  316. ' ************************************************
  317. Sub SetKa(R As Single, G As Single, B As Single)
  318.     Kar = R
  319.     Kag = G
  320.     Kab = B
  321. End Sub
  322.  
  323.